home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / ace_gpl_release / src_ansi / ace / c / file.c < prev    next >
Encoding:
C/C++ Source or Header  |  1999-01-05  |  18.3 KB  |  850 lines
  1. /* << ACE >>
  2.  
  3.    -- Amiga BASIC Compiler --
  4.  
  5.    ** Parser: file functions **
  6.    ** Copyright (C) 1998 David Benn
  7.    ** 
  8.    ** This program is free software; you can redistribute it and/or
  9.    ** modify it under the terms of the GNU General Public License
  10.    ** as published by the Free Software Foundation; either version 2
  11.    ** of the License, or (at your option) any later version.
  12.    **
  13.    ** This program is distributed in the hope that it will be useful,
  14.    ** but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.    ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.    ** GNU General Public License for more details.
  17.    **
  18.    ** You should have received a copy of the GNU General Public License
  19.    ** along with this program; if not, write to the Free Software
  20.    ** Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21.  
  22.    Author: David J Benn
  23.    Date: 26th October-30th November, 1st-13th December 1991,
  24.    14th,20th-27th January 1992, 
  25.    2nd-17th, 21st-29th February 1992, 
  26.    1st,13th,14th,22nd,23rd March 1992,
  27.    21st,22nd April 1992,
  28.    2nd,3rd,11th,15th,16th May 1992,
  29.    7th,8th,9th,11th,13th,14th,28th,29th,30th June 1992,
  30.    2nd-8th,14th-19th,26th-29th July 1992,
  31.    1st-3rd,7th,8th,9th August 1992,
  32.    6th,7th December 1992,
  33.    4th,5th,6th January 1993,
  34.    12th,14th,15th February 1993,
  35.    1st March 1993,
  36.    9th,17th,18th May 1993,
  37.    15th December 1993,
  38.    2nd January 1994,
  39.    11th March 1995,
  40.    10th March 1996
  41.  */
  42.  
  43. #include "acedef.h"
  44. #include <string.h>
  45.  
  46. /* locals */
  47. static char *frame_ptr[] = {"(a4)", "(a5)"};
  48.  
  49. /* externals */
  50. extern int lev;
  51. extern int sym;
  52. extern int obj;
  53. extern int typ;
  54. extern BOOL end_of_source;
  55. extern SYM *curr_item;
  56. extern char id[MAXIDSIZE];
  57. extern char tempstrname[80];
  58.  
  59. /* functions */
  60. void open_a_file (void)
  61. {
  62.   /* OPEN mode,[#]filenumber,filespec */
  63.  
  64.   check_for_event ();
  65.  
  66.   insymbol ();
  67.   if (expr () != stringtype)
  68.     _error (4);            /* mode = I, O or A */
  69.   else
  70.     {
  71.       if (sym != comma)
  72.     _error (16);
  73.       else
  74.     {
  75.       insymbol ();
  76.       if (sym == hash)
  77.         insymbol ();    /* # filenumber */
  78.       if (make_integer (expr ()) == shorttype)
  79.         make_long ();    /* 1..255 */
  80.       if (sym != comma)
  81.         _error (16);
  82.       else
  83.         {
  84.           insymbol ();
  85.           if (expr () != stringtype)
  86.         _error (4);    /* filespec */
  87.           else
  88.         {
  89.           /* pop arguments */
  90.           gen ("move.l", "(sp)+", "a1");    /* address of filespec */
  91.           gen ("move.l", "(sp)+", "d0");    /* filenumber */
  92.           gen ("move.l", "(sp)+", "a0");    /* address of mode string */
  93.  
  94.           gen ("jsr", "_openfile", "  ");
  95.           enter_XREF ("_openfile");
  96.           enter_XREF ("_DOSBase");
  97.         }
  98.         }
  99.     }
  100.     }
  101. }
  102.  
  103. void close_a_file (void)
  104. {
  105.   /* CLOSE [#]filenumber[,[#]filenumber..] */
  106.  
  107.   check_for_event ();
  108.  
  109.   do
  110.     {
  111.       insymbol ();
  112.       if (sym == hash)
  113.     insymbol ();
  114.       if (make_integer (expr ()) == shorttype)
  115.     make_long ();        /* filenumber = 1..255 */
  116.  
  117.       gen ("move.l", "(sp)+", "d0");
  118.       gen ("jsr", "_closefile", "  ");
  119.     }
  120.   while (sym == comma);
  121.  
  122.   enter_XREF ("_closefile");
  123.   enter_XREF ("_DOSBase");
  124. }
  125.  
  126. void line_input (void)
  127. {
  128.   char addrbuf[40];
  129.   SYM *storage;
  130.  
  131.   /* LINE INPUT  [;][prompt-string;]string-variable
  132.      LINE INPUT# filenumber;string-variable
  133.  
  134.      Note: only the latter is currently implemented.
  135.    */
  136.  
  137.   check_for_event ();
  138.  
  139.   insymbol ();
  140.  
  141.   if (sym != hash)
  142.     _error (44);
  143.   else
  144.     {
  145.       insymbol ();
  146.  
  147.       if (make_integer (expr ()) == shorttype)
  148.     make_long ();        /* filenumber = 1..255 */
  149.  
  150.       if (sym != comma)
  151.     _error (16);
  152.       else
  153.     {
  154.       insymbol ();
  155.  
  156.       if (sym == ident && obj == variable)
  157.         {
  158.           /* if string variable/array doesn't exist, create a simple variable */
  159.           if (!exist (id, variable) && !exist (id, array))
  160.         {
  161.           /* allocate a simple string variable */
  162.           enter (id, typ, obj, 0);
  163.           enter_DATA("_nullstring:", "dc.b 0");
  164.           gen ("pea", "_nullstring", "  ");
  165.           assign_to_string_variable (curr_item, MAXSTRLEN);
  166.         }
  167.  
  168.           storage = curr_item;
  169.  
  170.           /* is it a string variable or array? */
  171.           if (storage->type != stringtype)
  172.         _error (4);
  173.           else
  174.         {
  175.           /* get address of string pointed to by variable/array element */
  176.           itoa (-1 * storage->address, addrbuf, 10);
  177.           strcat (addrbuf, frame_ptr[lev]);
  178.  
  179.           /* pass filenumber (d0) and string address (a0) to function */
  180.           if (storage->object == array)
  181.             {
  182.               point_to_array (storage, addrbuf);
  183.               gen ("move.l", addrbuf, "a0");
  184.               gen ("adda.l", "d7", "a0");
  185.             }
  186.           else
  187.             gen ("move.l", addrbuf, "a0");    /* string address */
  188.  
  189.           gen ("move.l", "(sp)+", "d0");    /* filenumber */
  190.  
  191.           /* call _line_input */
  192.           gen ("jsr", "_line_input", "  ");
  193.           enter_XREF ("_line_input");
  194.  
  195.           insymbol ();
  196.           if (sym == lparen && storage->object != array)
  197.             _error (71);    /* undeclared array */
  198.         }
  199.         }
  200.       else
  201.         _error (19);    /* variable (or array) expected */
  202.     }
  203.     }
  204. }
  205.  
  206. void write_to_file (void)
  207. {
  208.   int wtype;
  209.  
  210.   /* WRITE #filenumber,expression-list */
  211.  
  212.   check_for_event ();
  213.  
  214.   insymbol ();
  215.  
  216.   if (sym != hash)
  217.     _error (44);
  218.   else
  219.     {
  220.       insymbol ();
  221.  
  222.       if (make_integer (expr ()) == shorttype)
  223.     make_long ();        /* filenumber = 1..255 */
  224.  
  225.       gen ("move.l", "(sp)+", "_seq_filenumber");
  226.  
  227.       if (sym != comma)
  228.     _error (16);
  229.       else
  230.     {
  231.       /* get expressions */
  232.       do
  233.         {
  234.           insymbol ();
  235.           wtype = expr ();
  236.  
  237.           switch (wtype)
  238.         {
  239.         case undefined:
  240.           _error (0);    /* expression expected */
  241.           break;
  242.  
  243.         case shorttype:
  244.           gen ("move.w", "(sp)+", "d1");
  245.           gen ("move.l", "_seq_filenumber", "d0");
  246.           gen ("jsr", "_writeshort", "  ");
  247.           enter_XREF ("_writeshort");
  248.           break;
  249.  
  250.         case longtype:
  251.           gen ("move.l", "(sp)+", "d1");
  252.           gen ("move.l", "_seq_filenumber", "d0");
  253.           gen ("jsr", "_writelong", "  ");
  254.           enter_XREF ("_writelong");
  255.           break;
  256.  
  257.         case singletype:
  258.           gen ("move.l", "(sp)+", "d1");
  259.           gen ("move.l", "_seq_filenumber", "d0");
  260.           gen ("jsr", "_writesingle", "  ");
  261.           enter_XREF ("_writesingle");
  262.           enter_XREF ("_MathBase");
  263.           break;
  264.  
  265.         case stringtype:
  266.           gen ("move.l", "_seq_filenumber", "d0");
  267.           gen ("jsr", "_writequote", "  ");
  268.           gen ("move.l", "(sp)+", "a0");
  269.           gen ("move.l", "_seq_filenumber", "d0");
  270.           gen ("jsr", "_writestring", "  ");
  271.           gen ("move.l", "_seq_filenumber", "d0");
  272.           gen ("jsr", "_writequote", "  ");
  273.           enter_XREF ("_writequote");
  274.           enter_XREF ("_writestring");
  275.           break;
  276.         }
  277.  
  278.           /* need a delimiter? */
  279.           if (sym == comma)
  280.         {
  281.           gen ("move.l", "_seq_filenumber", "d0");
  282.           gen ("jsr", "_writecomma", "  ");
  283.           enter_XREF ("_writecomma");
  284.         }
  285.  
  286.         }
  287.       while (sym == comma);
  288.  
  289.       /* write LF to mark EOLN */
  290.       gen ("move.l", "_seq_filenumber", "d0");
  291.       gen ("jsr", "_write_eoln", "  ");
  292.       enter_XREF ("_write_eoln");
  293.  
  294.       enter_XREF ("_DOSBase");
  295.       enter_BSS ("_seq_filenumber:", "ds.l 1");
  296.     }
  297.     }
  298. }
  299.  
  300. void gen_writecode (int code)
  301. {
  302.   /* write special character sequence to a file */
  303.  
  304.   check_for_event ();
  305.  
  306.   gen ("move.l", "_seq_filenumber", "d0");
  307.  
  308.   switch (code)
  309.     {
  310.       /* LF */
  311.     case LF_CODE:
  312.       gen ("jsr", "_write_eoln", "  ");
  313.       enter_XREF ("_write_eoln");
  314.       break;
  315.       /* TAB */
  316.     case TAB_CODE:
  317.       gen ("jsr", "_writeTAB", "  ");
  318.       enter_XREF ("_writeTAB");
  319.       break;
  320.       /* SPACE */
  321.     case SPACE_CODE:
  322.       gen ("jsr", "_writeSPC", "  ");
  323.       enter_XREF ("_writeSPC");
  324.       break;
  325.     }
  326. }
  327.  
  328. void print_to_file (void)
  329. {
  330.   int exprtype, arguments = 0;
  331.  
  332.   /* PRINT #filenumber,expression-list */
  333.  
  334.   check_for_event ();
  335.  
  336.   insymbol ();
  337.  
  338.   if (make_integer (expr ()) == shorttype)
  339.     make_long ();        /* filenumber 1..255 */
  340.  
  341.   gen ("move.l", "(sp)+", "_seq_filenumber");
  342.   enter_BSS ("_seq_filenumber:", "ds.l 1");
  343.  
  344.   if (sym != comma)
  345.     _error (16);
  346.   else
  347.     {
  348.       do
  349.     {
  350.       if (sym != ident && !strfunc () && !numfunc () && !factorfunc () &&
  351.           obj != constant)
  352.         insymbol ();    /* ident/func/literal after a space or as first parameter */
  353.  
  354.       /* end of line, multi-statement, ";", "," ELSE or comment 
  355.          after "PRINT #filenumber," ? -> don't proceed to expr! */
  356.  
  357.       if ((sym == endofline) || (sym == colon) || (sym == apostrophe) ||
  358.           (sym == semicolon) || (sym == comma) || (sym == elsesym) ||
  359.           (end_of_source))
  360.         {
  361.           if (sym == comma)
  362.         gen_writecode (TAB_CODE);
  363.           else if ((arguments == 0) && (sym != semicolon))
  364.         gen_writecode (LF_CODE);    /* "PRINT #filenumber," with no args */
  365.  
  366.           if (sym != colon && sym != elsesym)
  367.         insymbol ();    /* leave colon for multi-statement 
  368.                    in statement() or leave ELSE for if_statement() */
  369.           return;
  370.         }
  371.  
  372.       /* get an expression */
  373.       exprtype = expr ();
  374.  
  375.       if (exprtype == undefined)
  376.         {
  377.           _error (0);
  378.           return;
  379.         }            /* illegal syms? */
  380.  
  381.       /* pass filenumber to write routine */
  382.       if (exprtype == stringtype)
  383.         gen ("move.l", "_seq_filenumber", "d0");
  384.       else
  385.         gen ("move.l", "_seq_filenumber", "d1");
  386.  
  387.       switch (exprtype)
  388.         {
  389.         case shorttype:
  390.           gen ("move.w", "(sp)+", "d0");
  391.           gen ("jsr", "_fprintshort", "  ");
  392.           enter_XREF ("_fprintshort");
  393.           break;
  394.  
  395.         case longtype:
  396.           gen ("move.l", "(sp)+", "d0");
  397.           gen ("jsr", "_fprintlong", "  ");
  398.           enter_XREF ("_fprintlong");
  399.           break;
  400.  
  401.         case singletype:
  402.           gen ("move.l", "(sp)+", "d0");
  403.           gen ("jsr", "_fprintsingle", "  ");
  404.           enter_XREF ("_fprintsingle");
  405.           enter_XREF ("_MathBase");
  406.           break;
  407.  
  408.         case stringtype:
  409.           gen ("movea.l", "(sp)+", "a0");
  410.           gen ("jsr", "_writestring", "  ");
  411.           enter_XREF ("_writestring");
  412.           break;
  413.         }
  414.  
  415.       if (exprtype != stringtype)
  416.         gen_writecode (SPACE_CODE);        /* trailing space for any number */
  417.  
  418.       arguments++;
  419.  
  420.       if (sym == comma)
  421.         gen_writecode (TAB_CODE);
  422.  
  423.     }
  424.       while ((sym == comma) || (sym == semicolon) || (sym == ident) ||
  425.          strfunc () || numfunc () || factorfunc () || obj == constant);
  426.  
  427.       /* no comma or semicolon at end of PRINT# -> LF */
  428.       gen_writecode (LF_CODE);
  429.     }
  430. }
  431.  
  432. void input_from_file (void)
  433. {
  434.   char addrbuf[80];
  435.   SYM *storage;
  436.  
  437.   /* INPUT #filenumber,variable-list */
  438.  
  439.   check_for_event ();
  440.  
  441.   insymbol ();
  442.  
  443.   if (make_integer (expr ()) == shorttype)
  444.     make_long ();        /* filenumber 1..255 */
  445.  
  446.   gen ("move.l", "(sp)+", "_seq_filenumber");
  447.   enter_BSS ("_seq_filenumber:", "ds.l 1");
  448.  
  449.   if (sym != comma)
  450.     _error (16);
  451.   else
  452.     {
  453.       do
  454.     {
  455.       /* allocate variable storage, call _input* and store value in variable */
  456.  
  457.       insymbol ();
  458.  
  459.       if ((sym == ident) && (obj == variable))
  460.         {
  461.           if ((!exist (id, obj)) && (!exist (id, array)))
  462.         enter (id, typ, obj, 0);    /* allocate storage for a simple variable */
  463.  
  464.           storage = curr_item;
  465.  
  466.           itoa (-1 * storage->address, addrbuf, 10);
  467.           strcat (addrbuf, frame_ptr[lev]);
  468.  
  469.           /* ALL data types need a temporary string pointer in a1 */
  470.           make_temp_string ();
  471.           gen ("lea", tempstrname, "a0");    /* unique temp holder */
  472.  
  473.           /* when storing an input value into an array element, must save
  474.              value (d0) first, since array index calculation may be corrupted
  475.              if index has to be coerced from ffp to short.
  476.            */
  477.  
  478.           /* pass file number */
  479.           gen ("move.l", "_seq_filenumber", "d0");
  480.  
  481.           switch (storage->type)
  482.         {
  483.         case shorttype:
  484.           gen ("jsr", "_finputshort", "  ");
  485.  
  486.           if (storage->object == variable)
  487.             {
  488.               if ((storage->shared) && (lev == ONE))
  489.             {
  490.               gen ("move.l", addrbuf, "a0");    /* abs address of store */
  491.               gen ("move.w", "d0", "(a0)");
  492.             }
  493.               else
  494.             /* ordinary variable */
  495.             gen ("move.w", "d0", addrbuf);
  496.             }
  497.           else if (storage->object == array)
  498.             {
  499.               gen ("move.w", "d0", "_short_input_temp");
  500.               point_to_array (storage, addrbuf);
  501.               gen ("move.w", "_short_input_temp", "0(a2,d7.L)");
  502.               enter_BSS ("_short_input_temp:", "ds.w 1");
  503.             }
  504.  
  505.           enter_XREF ("_finputshort");
  506.           break;
  507.  
  508.         case longtype:
  509.           gen ("jsr", "_finputlong", "  ");
  510.  
  511.           if (storage->object == variable)
  512.             {
  513.               if ((storage->shared) && (lev == ONE))
  514.             {
  515.               gen ("move.l", addrbuf, "a0");    /* abs address of store */
  516.               gen ("move.l", "d0", "(a0)");
  517.             }
  518.               else
  519.             /* ordinary variable */
  520.             gen ("move.l", "d0", addrbuf);
  521.             }
  522.           else if (storage->object == array)
  523.             {
  524.               gen ("move.l", "d0", "_long_input_temp");
  525.               point_to_array (storage, addrbuf);
  526.               gen ("move.l", "_long_input_temp", "0(a2,d7.L)");
  527.               enter_BSS ("_long_input_temp:", "ds.l 1");
  528.             }
  529.  
  530.           enter_XREF ("_finputlong");
  531.           break;
  532.  
  533.         case singletype:
  534.           gen ("jsr", "_finputsingle", "  ");
  535.  
  536.           if (storage->object == variable)
  537.             {
  538.               if ((storage->shared) && (lev == ONE))
  539.             {
  540.               gen ("move.l", addrbuf, "a0");    /* abs address of store */
  541.               gen ("move.l", "d0", "(a0)");
  542.             }
  543.               else
  544.             /* ordinary variable */
  545.             gen ("move.l", "d0", addrbuf);
  546.             }
  547.           else if (storage->object == array)
  548.             {
  549.               gen ("move.l", "d0", "_long_input_temp");
  550.               point_to_array (storage, addrbuf);
  551.               gen ("move.l", "_long_input_temp", "0(a2,d7.L)");
  552.               enter_BSS ("_long_input_temp:", "ds.l 1");
  553.             }
  554.  
  555.           enter_XREF ("_finputsingle");
  556.           enter_XREF ("_MathBase");    /* need math libs */
  557.           enter_XREF ("_MathTransBase");
  558.           break;
  559.  
  560.         case stringtype:
  561.           gen ("jsr", "_finputstring", "  ");
  562.  
  563.           gen ("move.l", "a0", "-(sp)");
  564.  
  565.           if (storage->object == variable)
  566.             assign_to_string_variable (storage, MAXSTRLEN);
  567.           else if (storage->object == array)
  568.             {
  569.               point_to_array (storage, addrbuf);
  570.               assign_to_string_array (addrbuf);
  571.             }
  572.  
  573.           enter_XREF ("_finputstring");
  574.           break;
  575.         }
  576.         }
  577.       else
  578.         _error (19);
  579.  
  580.       insymbol ();
  581.       if (sym == lparen && storage->object != array)
  582.         _error (71);    /* undeclared array */
  583.     }
  584.       while (sym == comma);
  585.     }
  586. }
  587.  
  588. void kill (void)
  589. {
  590. /* KILL <filespec> */
  591.  
  592.   check_for_event ();
  593.  
  594.   insymbol ();
  595.   if (expr () != stringtype)
  596.     _error (4);
  597.   else
  598.     {
  599.       gen ("move.l", "(sp)+", "d1");
  600.       gen ("jsr", "_kill", "  ");
  601.       enter_XREF ("_kill");
  602.     }
  603. }
  604.  
  605. void ace_rename (void)
  606. {
  607. /* NAME <filespec1> AS <filespec2> */
  608.  
  609.   check_for_event ();
  610.  
  611.   insymbol ();
  612.   if (expr () != stringtype)
  613.     _error (4);
  614.   else
  615.     {
  616.       if (sym != assym)
  617.     _error (72);
  618.       else
  619.     {
  620.       insymbol ();
  621.       if (expr () != stringtype)
  622.         _error (4);
  623.       else
  624.         {
  625.           gen ("move.l", "(sp)+", "d2");    /* <filespec2> */
  626.           gen ("move.l", "(sp)+", "d1");    /* <filespec1> */
  627.           gen ("jsr", "_ace_rename", "  ");
  628.           enter_XREF ("_ace_rename");
  629.         }
  630.     }
  631.     }
  632. }
  633.  
  634. void ace_chdir (void)
  635. {
  636. /* CHDIR <dirname> */
  637.  
  638.   check_for_event ();
  639.  
  640.   insymbol ();
  641.  
  642.   if (expr () != stringtype)
  643.     _error (4);
  644.   else
  645.     {
  646.       /* call code to change directory */
  647.       gen ("move.l", "(sp)+", "d1");    /* dirname */
  648.       gen ("jsr", "_ace_chdir", "  ");
  649.       enter_XREF ("_ace_chdir");
  650.     }
  651. }
  652.  
  653. void files (void)
  654. {
  655. /* FILES [TO <storefile>] [,<target>] */
  656.  
  657.   check_for_event ();
  658.  
  659.   insymbol ();
  660.  
  661.   /* storage file specified? */
  662.   if (sym == tosym)
  663.     {
  664.       insymbol ();
  665.       if (expr () != stringtype)
  666.     _error (4);
  667.     }
  668.   else
  669.     gen ("move.l", "#0", "-(sp)");    /* NULL for storage file name */
  670.  
  671.   /* target file or directory specified? */
  672.   if (sym == comma)
  673.     {
  674.       insymbol ();
  675.       if (expr () != stringtype)
  676.     _error (4);
  677.     }
  678.   else
  679.     gen ("move.l", "#0", "-(sp)");    /* NULL for target name */
  680.  
  681.   /* call _files routine */
  682.   gen ("jsr", "_files", "  ");
  683.   gen ("addq", "#4", "sp");
  684.   enter_XREF ("_files");
  685. }
  686.  
  687. void push_struct_var_info (SYM * structVar)
  688. {
  689.   char addrbuf[40], sizebuf[10];
  690.  
  691.   /*
  692.      ** Push address held by structure variable.
  693.    */
  694.   sprintf (addrbuf, "%d%s", -1 * structVar->address, frame_ptr[lev]);
  695.   if (structVar->shared && lev == ONE)
  696.     {
  697.       /*
  698.          ** Shared structure variable.
  699.        */
  700.       gen ("movea.l", addrbuf, "a0");    /* struct variable address */
  701.       gen ("move.l", "(a0)", "-(sp)");    /* start address of struct */
  702.     }
  703.   else
  704.     /*
  705.        ** Local structure variable,
  706.        ** ie. in main program or SUB.
  707.      */
  708.     gen ("move.l", addrbuf, "-(sp)");    /* variable holds start address */
  709.  
  710.   /*
  711.      ** Push size of structure in bytes.
  712.    */
  713.   sprintf (sizebuf, "#%d", structVar->other->size);
  714.   gen ("move.l", sizebuf, "-(sp)");
  715. }
  716.  
  717. void random_file_get (void)
  718. {
  719. /*
  720.    ** Fill a structure from a random file.
  721.    **
  722.    ** SYNTAX: GET [#]fileNum, structVar [, recordNum]
  723.  */
  724.   SYM *structVar;
  725.  
  726.   check_for_event ();
  727.  
  728.   /* 
  729.      ** We already have the first symbol.
  730.      ** Skip `#' if present.
  731.    */
  732.   if (sym == hash)
  733.     insymbol ();
  734.  
  735.   /*
  736.      ** Get the file number.
  737.    */
  738.   if (make_integer (expr ()) == shorttype)
  739.     make_long ();        /* filenumber 1..255 */
  740.  
  741.   if (sym != comma)
  742.     _error (16);
  743.   else
  744.     {
  745.       /*
  746.          ** Structure variable address and size.
  747.        */
  748.       insymbol ();
  749.       if (!exist (id, structure))
  750.     _error (79);
  751.       else
  752.     {
  753.       structVar = curr_item;
  754.       push_struct_var_info (structVar);
  755.  
  756.       insymbol ();
  757.       if (sym == comma)
  758.         {
  759.           /*
  760.              ** Optional record number.
  761.            */
  762.           insymbol ();
  763.           if (make_integer (expr ()) == shorttype)
  764.         make_long ();    /* record number >= 1 */
  765.         }
  766.       else
  767.         /*
  768.            ** Tell library function not to
  769.            ** seek to a particular record 
  770.            ** before reading.
  771.          */
  772.         gen ("move.l", "#0", "-(sp)");
  773.  
  774.       /*
  775.          ** Call function.
  776.        */
  777.       gen ("jsr", "_GetRecord", "  ");
  778.       gen ("add.l", "#16", "sp");
  779.       enter_XREF ("_GetRecord");
  780.     }
  781.     }
  782. }
  783.  
  784. void random_file_put (void)
  785. {
  786. /*
  787.    ** Write a structure to a random file.
  788.    **
  789.    ** SYNTAX: PUT [#]fileNum, structVar [, recordNum]
  790.  */
  791.   SYM *structVar;
  792.  
  793.   check_for_event ();
  794.  
  795.   /* 
  796.      ** We already have the first symbol.
  797.      ** Skip `#' if present.
  798.    */
  799.   if (sym == hash)
  800.     insymbol ();
  801.  
  802.   /*
  803.      ** Get the file number.
  804.    */
  805.   if (make_integer (expr ()) == shorttype)
  806.     make_long ();        /* filenumber 1..255 */
  807.  
  808.   if (sym != comma)
  809.     _error (16);
  810.   else
  811.     {
  812.       /*
  813.          ** Structure variable address and size.
  814.        */
  815.       insymbol ();
  816.       if (!exist (id, structure))
  817.     _error (79);
  818.       else
  819.     {
  820.       structVar = curr_item;
  821.       push_struct_var_info (structVar);
  822.  
  823.       insymbol ();
  824.       if (sym == comma)
  825.         {
  826.           /*
  827.              ** Optional record number.
  828.            */
  829.           insymbol ();
  830.           if (make_integer (expr ()) == shorttype)
  831.         make_long ();    /* record number >= 1 */
  832.         }
  833.       else
  834.         /*
  835.            ** Tell library function not to
  836.            ** seek to a particular record 
  837.            ** before writing.
  838.          */
  839.         gen ("move.l", "#0", "-(sp)");
  840.  
  841.       /*
  842.          ** Call function.
  843.        */
  844.       gen ("jsr", "_PutRecord", "  ");
  845.       gen ("add.l", "#16", "sp");
  846.       enter_XREF ("_PutRecord");
  847.     }
  848.     }
  849. }
  850.